PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/eval_az.com/EVALUATE.PAS

Pascal/Delphi Source File | 1989-07-13 | 27.6 KB | 958 lines

{$V-}
{---------------------------------------------------------------------
 EVALUATOR UNIT TEST PROGRAM
 Arthur Zatarain, P.E.        C'Serve 3417-525    Bixen=ARTZAT
 Total Engineering Services Team, Inc.  (TEST Inc).
 New Orleans,  La.  [phone] Days
                          837-3699 Nites

This expression evaluator is based on a
Compuserve Upload by Neil J. Rubenking.

This program takes a legal arithmetic expression in the form of a
string and evaluates it.

Binary operators are +-/* ^, unary operators are - and %,
where prefixing an expression in parentheses with a %
causes it to be truncated to an integer.  To get #A mod #B,
you could do  "#A - (%(#A/#B)*#B)"

Variable Lists are handled as separate objects, and the address of the
object must be installed into the evaluator object befor using any
variable stuff.

An external process (see the evaluator test program) must set up and
remove variables.  I changed this from Neil's auto variable because I
really hate auto variables, and because out particular application would
not allow them.  This could easily be overidden if desired.

NOTE:  The program does not handle repeated unary operators w/o
parentheses -- "---1" is bad, "-(-(-1))" is good.

The process operates with an object called EVAL_TYPE which allows for
multiple concurrent instances of the evaluator.

One entry will return a real, while the other completely solves
for a variable to the left of the = and updates the variable.

Hooks are provided via virtual methods to allow for external
functions that take a single real variable.

---------------------------------------------------------------------------
HELP!  I would like to add the ability to have multiple argument
functions rather than single variables ones like we have here.  For example,
external functions like MAX(A,B) or MYFUNC(A,B,3,C,d) would be great!
---------------------------------------------------------------------------}


unit evaluate;

interface

{$define showit}

uses tpcrt, tpstring, testlib;

const
  var_name_size= 12;  { one size fits all }

type

  any_var_name = string[var_name_size];  { typical variable name }

  a_var_entry = record        { a single entry in the var list }
   var_name : string[12];  { always convert to upper case }
   var_value : real;    { only support reals for now }
  end;

 var_entry_list = array [1..1] of a_var_entry;  { a group of entries }

 A_var_list = object     { one group of variable entries }
   var_count : integer; {max number in the list}
   var_list  : ^var_entry_list;  { points to the variable list somewhre }

   constructor init(c:integer);   { how many will be in the list }
   function add_name( n : any_var_name; var index : integer) : boolean; virtual;
   procedure delete_name(n:any_var_name);                         virtual;
   function get_index(n : any_var_name; var index : integer): boolean; virtual;
   function get_by_name(n : any_var_name; var rx : real;
                        var index : integer ) : boolean;          virtual;
   function get_by_index(n : integer; var rx : real ) : boolean;  virtual;
   function set_by_name(n : any_var_name;  rx : real;
                        var index : integer ) : boolean;          virtual;
   function set_by_index(n : integer;  rx : real ) : boolean;     virtual;
 end;


 a_var_list_p = ^a_var_list;  { pointer so object can be passed around }


Int_Var = RECORD            {Internal Variable type}
  varName : string[8];  { max of 8 chars for variable names }
  value : Real;
end;


eval_type = object
  vTop, B_Dummy, B_Val : integer;
  eval_result : Real;        { what happens in the end }
  eval_err : Boolean;        { an error occured in evaluating }
  var_error : boolean;       { an error occued in the variable declaration}
  need_monitor : boolean;    { true if progress monitor needed}
  a_v_l   : a_var_list_p;    { points to current variable list }

  constructor init;
  procedure show_progress(m : small_string); virtual;
  procedure show_text(m : med_string);  virtual;
  procedure set_var_list(avl : a_var_list_p);  { set up the variabvle list }
{ hooks to externals }
  procedure show_error(m : med_string;  var go_on : boolean); virtual;
  function ext_fun_execute(i : integer; rx : real) : real; virtual;
  function ext_fun_search(s : small_string) : integer;   virtual;

  PROCEDURE set_variable(var L : small_string);

  function solve(EL : string) :boolean;  { solve into RR }

  function do_evaluate(var  line : string) : boolean;

end;
eval_type_ptr = ^eval_type;


implementation
  uses printf;


const
  nl = acr+alf;

TYPE

  char_set = SET of Char;

  treePtr   = ^node;
  whichType = (lef,rit,mid,bra,mor);  { which type of element we are parsing}
  tagtype   = (valuop, unop, bnop,funop );
  binop_type =(badd,bsub,bmul,bdiv,
               bpwr,     { power }
               bor,      { logical or }
               band,     { logical and }
               beq,      { equals }
               bgt,      { > }
               blt,      { < }
               blteq,    {<= }
               bgteq);  { >=}

  una_type  = (posit,neg,intg,
              fun_bogus,fun_external, fun_sqrt, fun_sqr,fun_int,fun_frac,
              fun_pi,fun_abs, fun_round,fun_sin,fun_cos,fun_arctan,fun_tan,
              fun_trunc);


node = record
  case tag : tagtype of
    valuop : (value : real);
    unop   : (UnaOp : una_type; branch : TreePtr;
              external_code : integer);
    bnop   : (left : treePtr; BinOp : binop_type;
              right  : treePtr  );
 end;



CONST
  numbers : char_set = ['0'..'9', '.'];
  alphas  : char_set = ['A'..'Z', 'a'..'z'];
  delis : char_set = [' ', '+', '-', '(', '[', ')', ']', '*', '/','^',
                      '>', '<', '=','&','|'];


  alpha_code = #1;

{ ------------  VARIABLE PROCESSING METHODS ------------------}



{ call after memory is allocated for this unit so it cal further allocate
  memory for the actual variable space.  The object itself only contains
  the control information }
constructor a_var_list.init(c:integer);
var i : integer;
begin
  var_count := c;  { how many elements are in this particular instance }
  getmem(var_list, c * sizeof(a_var_entry));  { space for actual variables}
  for i := 1 to c do with var_list^[i] do begin
    var_name := '';  var_value := 0;  { empty slots have '' name }
  end;
end;


{ for speed assume that all variables are passed here in UPCASE}

{ Get the index into this object list for a particular variable.
  This is handy to speed things up in later processing as well as
  allowing the location rather than the name to be saved}

function a_var_list.get_index(n : any_var_name; var index : integer) :boolean;
var
i : integer;  ready : boolean;

begin
  index := 0;  { assume no index available }
  i := 1;  ready := false;   get_index := false; { assume no match}
  while not ready do with var_list^[i] do begin
    if var_name = n then begin
      ready := true;  index := i;  get_index := true;
    end;
    inc(i);  if i > var_count then ready := true;
  end;
end;


{ Match var will look for a variable and if found will return
  its value in RX}

{ add a new name to the list if it does not exist.  If it is already
  there, just return true }

function a_var_list.add_name( n : any_var_name; var index : integer) : boolean;

var I : integer;
ready : boolean;
rx2 : real;

begin
  add_name := true;  { assume already existing }
  if get_by_name(n, rx2, index) then exit;
  i := 1;   ready := false;
  repeat
    with var_list^[i] do begin
      if var_name = '' then begin     { found blank spot }
        index := i;  { return new position in the list }
        var_name := n;   ready := true;
        exit;  { leave with true result }
      end;
    end;
    inc(i);  if i > var_count then ready := true;
  until ready;
  add_name := false;  { could not make room }
end;  { adding a new one }


function a_var_list.get_by_index(n : integer; var rx : real ) : boolean;
begin
  get_by_index := false;
  if (n <=0 ) or (n > var_count) then exit;
  rx := var_list^[n].var_value;
  get_by_index := true;
end;


function a_var_list.get_by_name(n : any_var_name; var rx : real;
                                var index : integer ) : boolean;
begin
  get_by_name := false;
  if get_index(n, index) then
  if get_by_index(index, rx) then get_by_name := true;

end;


function a_var_list.set_by_index(n : integer; rx : real ) : boolean;
begin
  set_by_index := false;
  if (n <=0 ) or (n > var_count) then exit;
  var_list^[n].var_value := rx;
  set_by_index := true;
end;

function a_var_list.set_by_name(n : any_var_name;  rx : real;
                                var index : integer ) : boolean;
begin
  set_by_name := false;
  if get_index(n, index) then  { get the index for this name }
  if set_by_index(index, rx) then set_by_name := true;
end;


{ remove a variable when we are thru with it }
procedure a_var_list.delete_name(n:any_var_name);

var i : integer;
ready : boolean;
begin
  i := 1;  ready := false;
  repeat
    with var_list^[i] do begin
      if var_name = n then begin     { found it }
        var_value:= 0;   ready := true;
      end;
    end;
    inc(i);  if i > var_count then ready := true;
  until ready;
end;


PROCEDURE eval_type.show_text(M : med_string);
begin
  write(m);
end;

{ show error and kill further operations }
procedure eval_type.show_error(m : med_string;  var go_on : boolean);
begin
  show_text(m);
  go_on:= false;
end;

{ This allows monitorong of the calculations }

procedure eval_type.show_progress(m: small_string);
begin
  if need_monitor then show_text(m);
end;

PROCEDURE eval_type.set_var_list(avl : a_var_list_p);
begin
  a_v_l := avl;
end;


PROCEDURE StripOut(CH : Char; var LL : med_string);
  (************************************************)
  (*  Strip all occurrences of the character CH   *)
  (*  out of the string LL.                       *)
  (************************************************)
begin
  while Pos(CH, LL) <> 0 do Delete(LL, Pos(CH, LL), 1);
end;

{ -------------------------------------------------------
  This is entry with EL containg the expression to evaluate.
  The result goes into eval_result, boolean result indicates errors.
  --------------------------------------------------------}

FUNCTION eval_type.solve(EL : string) : boolean;
var
  NumStr : med_string;
  C, N : Integer;
  evald : Boolean;



PROCEDURE NewEval(LL : med_string; var evR : real; var OK : Boolean);

var
  Rut  : treePtr;
  code : Integer;


PROCEDURE Into_Tree(S : med_string; Root : treePtr; a_v_l: a_var_list_p );
var
  ii : integer;
  temp : treePtr;
  item : med_string;
  which, holdwhich : whichType;
  a_variable : boolean;
  temp_op : una_type;  { temporary unary operator type }
  temp_code : integer; { temo external code number }


function Type_of(N : node):CHAR;
begin
  case N.tag of
    valuop : Type_of := 'V';
    unop : Type_of := 'U';
    bnop : Type_of := 'B';
    else Type_of := '?';
  end;
end;  { type_of }



FUNCTION letter(W : whichType):char;
begin
  case W of
    lef: letter := 'L';
    rit: letter := 'R';
    mid: letter := 'M';
    mor: letter := 'X';
    bra: letter := 'B';
  end;
end;  { letter }


PROCEDURE Put_Temp_In_Place;
begin
  case which of
    lef : begin
      Root^.tag := bnop;
      Root^.Left := temp;
      which := mid;
    end;

    rit : begin
      Root^.right := temp;
      which := mor;
    end;

    mid, mor : begin
      show_error(nl+'error in format!'+nl, ok);
    end;

    bra : begin
      case HoldWhich of
        mid : Root^.left^.branch := temp;
        mor : Root^.right^.branch := temp;
        bra : Root^.branch^.branch := temp;
        else show_error(nl+'Error with unary operator '+letter(HoldWhich)+nl,ok);
      end;
      which := HoldWhich;
    end;
  end;
end;  { put temp in place }


PROCEDURE SplitOff(var SS, SItem : med_string; var ok : boolean);
var
  N, P, Parens : Byte;

begin
  N := 1;
  while S[N] = ' ' do N := N+1;  { skip white space }

  case s[n] of
    '(' : begin
      P := N;
      Parens := 1;
      repeat
        P := P+1;
        if S[P] = '(' then Parens := Parens+1;
        if S[P] = ')' then Parens := Parens-1;
      until (Parens = 0) OR (P = Length(S));
      if Parens <> 0 then
        begin
          show_error(nl+'Error -- no right ('+nl, ok);
        end
      else
        begin
          sitem := Copy(S, N, P-N+1);
          Delete(S, 1, P);
        end;
    end;

    '[' : begin
      P := N;
      Parens := 1;
      repeat
        P := P+1;
        if S[P] = '[' then Parens := Parens+1;
        if S[P] = ']' then Parens := Parens-1;
      until (Parens = 0) OR (P = Length(S));
      if Parens <> 0 then
        begin
          show_error(nl+'Error -- no right ]'+nl, ok);
        end
      else begin
        sitem := Copy(S, N, P-N+1);
        Delete(S, 1, P);
      end;
    end;

{ Modified variable declaration.  May also be a function}

    'A'..'Z','a'..'z' : begin
      P := N;  { where to start looking for the variable }
      repeat
        P := P+1   { advance to next delimiter }
      until S[P] IN delis;
      sitem := Copy(S, N, P-N);  { pull out the variable name }
      sitem := stupcase(item);  { always use upper case here }
      Delete(S, 1, P-1);  { strip out the variable }
    end;

    '+', '-', '*', '/', '%','^',
    '>', '<', '=','&','|' : begin   { math operator of some sort }
      sitem := S[N];
      Delete(S, 1, N);  { This seems confused by ^ ahead of number }
    end;

    '0'..'9' : begin         { a number of some sort }
      P := N;
      repeat P := P+1 until NOT(S[P] IN numbers);
      sitem := Copy(S, N, P-N);
      Delete(S, 1, P-1);

    end;

    else show_error(nl+'Not a valid character here '+S[N]+nl, ok);
  end;                  {case}
end;                    {SplitOff}


begin  { start of into_tree }
  with a_v_l^ do begin  { give us access to the external variable list }
  which := lef;  { looking for a left thing }

  ok := True;
  while (S[0] > #0) and ok do begin   { something left on the line }
    SplitOff(S, item,ok);  { take next item FROM S }
    item := stupcase(item);
    a_variable := true;       { let variables run if no function found }

    case item[1] of
      '0'..'9' : begin
        New(temp);
        temp^.tag := valuop;
        Val(item, temp^.value, code);  { convert string to number }
        if code <> 0 then
          show_error(nl+'Invalid numeric format '+item+nl, ok)
        else Put_Temp_In_Place;
      end;


      '(', '[' : begin
          item[0] := Pred(item[0]);
          item[1] := ' ';
          New(temp);
          Into_Tree(item, temp,a_v_l);
          Put_Temp_In_Place;
        end;


{ Check for possible function, then check for variable }
       'A'..'Z','a'..'z',
       '@' : begin   { special function is like a unary operator }
{ before processing, we need to find out what kind of function this is }

         temp_op := fun_bogus;         { assume no function match at all }

         if item = 'SQR'    then temp_op := fun_sqr;
         if item = 'SQRT'   then temp_op := fun_sqrt;
         if item = 'INT'    then temp_op := fun_int;
         if item = 'FRAC'   then temp_op := fun_frac;
         if item = 'PI'     then temp_op := fun_pi;
         if item = 'ABS'    then temp_op := fun_abs;
         if item = 'ROUND'  then temp_op := fun_round;
         if item = 'SIN'    then temp_op := fun_sin;
         if item = 'COS'    then temp_op := fun_cos;
         if item = 'TAN'    then temp_op := fun_tan;
         if item = 'ARCTAN' then temp_op := fun_arctan;
         if item = 'TRUNC'  then temp_op := fun_trunc;

         if temp_op = fun_bogus then begin { external functions }
           temp_code :=0;  { asssume no match }
            temp_code := ext_fun_search(item);  { look for an external funct}
            if temp_code <> 0 then begin { one was found }
              temp_op := fun_external;
            end;
         end;

         if temp_op = fun_bogus then a_variable := true
         else a_variable := false;

         if not a_variable  then begin  { some sort of  function found }
           case which of
             lef, rit, bra : begin
               new(temp);        { get another block of memory }
               with temp^ do begin
                 tag := unop;  { identify as a function block}
                 unaop := temp_op; { what kind of function }
                 external_code := temp_code; { if an external, which one}
               end;
               Put_Temp_In_Place;
               HoldWhich := which;
               which := bra;
             end;  { lef, rit, bra }
             mor : begin  { middle or right }
               New(temp);
               temp^ := root^;
               root^.tag := bnop;
               root^.binop := bsub;
               root^.left := temp;
               which := rit;
             end;  { mor}
             mid : begin
               root^.binop := bsub;
               which := rit;
             end;  { mid}
             else show_error(nl+'Bad Function= '+nl, ok);
           end;  { case which }
         end;  { setting up a function }

         if a_variable then begin
           new(temp);
           with temp^ do begin
             tag := valuop;  { indicate it's a value }
(*
             get_var_value(item, value, self);
*)
             if get_by_name(item, value, ii) then
             Put_Temp_In_Place;
          end;
         end;  { setting up a variable}
        end;

       '%' : begin
         new(temp);
         temp^.tag := UnOp;
         temp^.unaop := intg;
         Put_Temp_In_Place;
         HoldWhich := which;
         which := bra;
       end;

       '-' : begin
         case which of
           lef, rit, bra : begin
             new(temp);
             temp^.tag := UnOp;
             temp^.UnaOp := neg;
             Put_Temp_In_Place;
             HoldWhich := which;
             which := bra;
           end;
           mor : begin
             New(temp);
             temp^ := root^;
             root^.tag := bnop;
             root^.binop := bsub;
             root^.left := temp;
             which := rit;
           end;
           mid : begin
             root^.binop := bsub;
             which := rit;
           end;
          else show_error(nl+'Bad expression'+nl, ok);
        end;
      end;  { - }


      '+', '*', '/', '^','>','<','=',
      '&', '|' : begin   { binary operations follow}
        case which of
          mid : begin  { looking for the middle operator }
            case item[1] of
              '+' : root^.binop := badd;
              '*' : root^.binop := bmul;
              '/' : root^.binop := bdiv;
              '^' : root^.binop := bpwr;
              '>' : root^.binop := bgt;
              '<' : root^.binop := blt;
              '=' : root^.binop := beq;
              '&' : root^.binop := band;
              '|' : root^.binop := bor;
            end;
            which := rit;  { better find a right operand }
          end;  { mid }

          mor : begin  { middle or right operator }
            New(temp);
            temp^ := root^;
            root^.tag := bnop;
            case item[1] of
              '+' : root^.binop := badd;
              '*' : root^.binop := bmul;
              '/' : root^.binop := bdiv;
              '^' : root^.binop := bpwr;
              '>' : root^.binop := bgt;
              '<' : root^.binop := blt;
              '=' : root^.binop := beq;
              '|' : root^.binop := bor;
              '&' : root^.binop := band;
            end;
            root^.left := temp;
            which := rit;  { should be more to come }
          end;
          else show_error(nl+'Error in format'+nl, ok);
        end;  { case }
      end;  { '+', '*', '/','^' }


    end;                {case}
  end;                  {while}

  case which of
    rit : show_error(nl+'Second operand missing!'+nl, ok);
    mid : begin
      temp := root^.left;
      root^ := root^.left^;
      dispose(temp);
    end;
    bra : show_error(nl+'Unary operand missing+nl', ok);
    lef : show_error(nl+'Left side missing?'+nl, ok);
    mor :;
  end;
  end;  {a ccess to variable list object }
end;


{ This will reduce a tree node by doing the math as necessary }

FUNCTION ExprValue(T : treePtr) : Real;
var   v1, v2 : Real;
rx : real;
begin
  case T^.tag of
    valuop : begin       { end of the tree, say the number }
{$ifdef showit}
      if need_monitor then show_progress(fmtreal('d2',t^.value)+'= ');
{$endif}
      ExprValue := T^.value;
    end;

    unop : begin  { a unary operation }
{$ifdef showit}
      if t^.unaop > fun_bogus then
      if need_monitor then show_progress(fmtreal('d2',t^.value)+' (F) ');
{$endif}

      v1 := exprValue(T^.branch);
      case T^.UnaOp of
        fun_external : with t^ do begin
{$ifdef showit}
      if need_monitor then show_progress(fmtreal('d2',t^.value)+'-X- ');
{$endif}
          exprvalue := ext_fun_execute(external_code,v1);
        end;
        fun_sqrt  : exprvalue := sqrt(v1);
        fun_sqr   : exprvalue := sqr(v1);
        fun_int   : exprvalue := int(v1);
        fun_frac  : exprvalue := frac(v1);
        fun_pi    : exprvalue := pi * v1;
        fun_abs   : exprvalue := abs(v1);
        fun_round : exprvalue :=  round(v1);
        fun_sin   : exprvalue :=  sin(v1);
        fun_cos   : exprvalue :=  cos(v1);

        fun_tan : begin
          rx := cos(v1);
          if rx <> 0 then exprvalue :=  sin(v1) / cos(v1)
          else exprvalue := 0;
        end;
        fun_arctan : exprvalue :=  arctan(v1);
        fun_trunc  : exprvalue :=  trunc(v1);

{ Normal unary options follow }
        posit : begin
          exprvalue := v1;
        end;

        neg : begin
          exprValue := -v1;
{$ifdef showit}
          if need_monitor then show_progress('- ');
{$endif}
        end;
        intg : begin         { chop to an integer }
          exprValue := Trunc(v1);
{$ifdef showit}
          if need_monitor then show_progress('% ');
{$endif}
        end;
      end;
    end;

    bnop : begin
      v1 := exprValue(T^.left);
      v2 := exprValue(T^.right);
      case T^.binop of
        badd : begin
          exprValue := v1+v2;
{$ifdef showit}
          if need_monitor then show_progress('+ ');
{$endif}
        end;
        bsub : begin
          exprValue := v1-v2;
{$ifdef showit}
          if need_monitor then show_progress('- ');
{$endif}
        end;
        bmul : begin
          exprValue := v1*v2;
{$ifdef showit}
          if need_monitor then show_progress('* ');
{$endif}
        end;
        bdiv : begin
          if v2 <> 0 then
          exprValue := v1/v2
          else exprvalue := realbig;  { avoid errors }
{$ifdef showit}
          if need_monitor then show_progress('/ ');
{$endif}
        end;
        bpwr : begin
          exprValue := power(v1,v2);  { DATARAN or TEST library function}
{$ifdef showit}
          if need_monitor then show_progress('^ ');
{$endif}
        end;

        blt : begin  { if V1 < v2  return 1 }
          if v1 < v2 then
          exprValue :=  1 else exprvalue := 0;
        end;

        bgt : begin  { if V1 > v2  return 1 }
          if v1 > v2 then
          exprValue :=  1 else exprvalue := 0;
        end;

        beq : begin  { if V1 = v2  return 1 }
          if v1 = v2 then
          exprValue :=  1 else exprvalue := 0;
        end;
        bor : begin  { if V1 or v2  return 1 }
          if trunc(v1) + trunc(v2) <> 0 then
          exprValue :=  1 else exprvalue := 0;
        end;
        band : begin  { if V1 AND v2  return 1 }
          if trunc(v1) * trunc(v2) <> 0 then
          exprValue :=  1 else exprvalue := 0;
        end;


      end;
    end;
  end;
  Dispose(T);
end;  { of expr value }


begin  { neweval start }

  New(RUT);
  Into_Tree(LL, Rut,a_v_l);
  if OK then begin

{$ifdef showit}
    show_progress(acr+alf);
    show_progress('RPN: ');
{$endif}

    evR := ExprValue(RUT);
  end;

end; { end of neweval}

begin    { solve start }
  NewEval(EL, eval_result,evald);
  solve := evald;
end;  { of solve }


{ Assign the resulting expression to the variable in sting.
  This entry is used if a variable is begin updated (or created)
  at the start of the main entry line.
}

PROCEDURE eval_type.set_variable(var L : small_string);
var
  VarStr : med_string;          {expression of var's value -- from "=" to end}
  VarNm : small_string;            {name of var -- from 2nd char to "="         }
  N : Byte;
  hit : boolean;
 treal : real;
 is_external : boolean;
 ok : boolean;
 index : integer;
  ii : integer;
begin
  with a_v_l^ do begin
  is_external := false;  { assume a local variable }

  if Pos('=', L) <> 0 then begin  { an assignment is being made }
    VarNm := Copy(L, 1, Pos('=', L)-1);  { first part of the line }
    varnm := stupcase(varnm);  { only look at uppers }

    StripOut(' ', VarNm);
    Delete(L, 1, Pos('=', L));  { remove first part of the line }
    VarStr := L;  { rest of the line that will be solved }

    hit := false;  { no find as yet }

    hit := get_by_name(varnm,treal,index);  { if there, return true and value}

    if hit then begin  { found the variable }
      if solve(VarStr) then      { solve the expression }
        if not set_by_name(varnm,eval_result,ii) then begin

        show_error(nl+'Error in line '+nl, ok);
        show_error(nl+'Variable Def error= '+ VarStr+nl, ok);
        var_error := True;
      end;
    end;
  end  { if no error in the initial variable setup }

  else begin  { if an error in setting up the variable }
    show_progress(acr+alf+'No "=" in variable definition.'+acr+alf);
    var_error := True;
  end;
  end;  { access to a_v_l }
end;  { of set var }



{ This is the external hook into the solver.  Call it with the string,
  and it will return a real.  In the structure.
  The boolean result indicates error.
  if it is just an expression (i.e. no = ), then the real result
  is calculated if possible.  if a Variable is being solved for at the
  left of the =, it is updated with the new value
}

function eval_type.do_evaluate(var  line : string) : boolean;
var well : boolean;

begin
    do_evaluate := false;
    var_error := false;
    well := true;
    if pos('=',line) <> 0 then
      set_variable(line)  { solve for a variable to left of =}
    else
      well := solve(line);  { solve and return results in struct}

    if not well then
    show_progress(acr+alf+'Error in expression!'+acr+alf);
    do_evaluate := well;
end;



{ Call to initiate a solving session }
constructor eval_type.init;
begin
  vtop := 0;
  var_error := false;
  eval_err := false;
  need_monitor := false;
  a_v_l := nil; { assume no variable list has been set up }
end;


{ The HOOKS below allow access to external functions.  The string name
  is the function, and the search should return 0 if no external
  function is found.  If it is found, return an index number.  This number
  will be sent later at evaluate time so the external function processor
  knows what to do to the real being passed to it.
}

function eval_type.ext_fun_search(s : small_string) : integer;
begin
  ext_fun_search := 0;
end;

{ Use the index code I to act on RX, return a real result }
function eval_type.ext_fun_execute(i : integer; rx : real) : real;
begin
  ext_fun_execute := 0;
end;


end.